#!/usr/bin/perl

######################################################################
package Swignition::GenericParser::Metadata;
######################################################################

use Swignition::GenericParser::HTTP;
use Swignition::MagicString;
use XML::LibXML qw(:all);

sub is_enabled
{
	my $this = shift;
	return $this->{options}->{p_metatags};
}

sub consume
{
	my $page = shift;

	# Parse <title>.
	my $S = Swignition::RDFModel::Subject->new($page->uri);
	foreach my $t ($page->{DOM}->getElementsByTagName('title'))
	{
		my $val = Swignition::RDFModel::Value->new(Swignition::GenericParser::Utils::STRINGIFY($t));
		$val->setDom($t);
		$S->addVal('http://purl.org/dc/terms/title', $val);
	}
	my $val = Swignition::RDFModel::Value->new('http://purl.org/dc/dcmitype/Text', 1);
	$val->setVocab('http://purl.org/dc/terms/DCMIType');
	$S->addVal('http://www.w3.org/1999/02/22-rdf-syntax-ns#type', $val);
	$page->mergeSubject($S);
	
	meta_tags($page);
	link_tags($page);
}

# TODO: Cognition used to support <link rel="dc.creator" ...> but once RDFa
# was implemented, I dropped rel handling from this function, because it became
# superfluous. However, RDFa doesn't support the somewhat more relaxed dot
# syntax that used to be supported for <link> elements. Should be added back.
# Note that this is successfully handled by eRDF module, but only when eRDF is
# enabled.   See T:test.
sub link_tags
{
	my $this = shift;
	my $myurl = $this->uri('');
	
	# Get list of links.
	my @links   = $this->{DOM}->getElementsByTagName('link');
	my @anchors = $this->{DOM}->getElementsByTagName('a');
	push @links, @anchors;
	
	# For each link
	foreach my $l (@links)
	{
		# Subject: Linked page
		my $href = $this->uri($l->getAttribute('href'));
		next unless (length $href);
		my $SubjectLinkedPage;
		
		# Handle @title.
		if (length $l->getAttribute('title'))
		{
			$SubjectLinkedPage = Swignition::RDFModel::Subject->new($href)
				unless ($SubjectLinkedPage);

			my $val = Swignition::RDFModel::Value->new($l->getAttribute('title'));
			$val->setDom($l);
			$SubjectLinkedPage->addVal('http://purl.org/dc/terms/title', $val);
		}

		# Handle @media.
		if (length $l->getAttribute('media'))
		{
			$SubjectLinkedPage = Swignition::RDFModel::Subject->new($href)
				unless ($SubjectLinkedPage);

			my $val = Swignition::RDFModel::Value->new($l->getAttribute('media'));
			$val->setDom($l);
#			$val->setVocab('http://www.w3.org/TR/CSS21/media.html#media-types');
			$SubjectLinkedPage->addVal('http://purl.org/dc/terms/format', $val);
		}

		# Handle @title.
		if (length $l->getAttribute('type'))
		{
			$SubjectLinkedPage = Swignition::RDFModel::Subject->new($href)
				unless ($SubjectLinkedPage);

			my $val = Swignition::RDFModel::Value->new($l->getAttribute('type'));
			$val->setDom($l);
			$val->setVocab('http://purl.org/dc/terms/IMT');
			$SubjectLinkedPage->addVal('http://purl.org/dc/terms/format', $val);
		}

		# Handle @lang/@hreflang.
		if (length $l->getAttribute('lang')
		||  length $l->getAttribute('xml:lang')
		||  length $l->getAttribute('hreflang'))
		{
			$SubjectLinkedPage = Swignition::RDFModel::Subject->new($href)
				unless ($SubjectLinkedPage);

			my $val = Swignition::RDFModel::Value->new(
				$l->getAttribute('hreflang') ||
				$l->getAttribute('xml:lang') ||
				$l->getAttribute('lang')
			);
			$val->setDom($l);
			$val->setVocab('http://purl.org/dc/terms/RFC4646');
			$SubjectLinkedPage->addVal('http://purl.org/dc/terms/language', $val);
		}

		$this->mergeSubject($SubjectLinkedPage);
	}
}

sub meta_tags
{
	my $this = shift;
	my $myurl = $this->uri;

	# Subject: This page
	my $SubjectThisPage = Swignition::RDFModel::Subject->new($myurl);		

	my $nsrdf   = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#';
	my $nshttp  = 'http://www.w3.org/2006/http#';
	my $nshttpH = 'http://www.w3.org/2008/http-headers#';
	my $nshttpM = 'http://www.w3.org/2008/http-methods#';
	my $nshttpS = 'http://www.w3.org/2008/http-statusCodes#';
	my $rdftype = $nsrdf.'type';

	$this->mergeNS('ianalink',
		'http://www.iana.org/assignments/relation/',
		'IANA Registered Link Types',
		-1,
		0);
	$this->mergeNS('ht',
		$nshttp,
		'HTTP Vocabulary in RDF',
		-1,
		0);
	$this->mergeNS('htx',
		'http://buzzword.org.uk/rdf/http-ext#',
		'HTTP Vocabulary in RDF Extentions',
		-1,
		0);
	$this->mergeNS('hth',
		$nshttpH,
		'HTTP Vocabulary in RDF (Headers)',
		-1,
		0);
	$this->mergeNS('htm',
		$nshttpM,
		'HTTP Vocabulary in RDF (Methods)',
		-1,
		0);
	$this->mergeNS('hts',
		$nshttpS,
		'HTTP Vocabulary in RDF (Status Codes)',
		-1,
		0);

	my $HTTPEq = Swignition::RDFModel::Subject->new(
		Swignition::GenericParser::Utils::BNodeURI(undef, 'HttpEquivHeaders'));
	$HTTPEq->addVal($rdftype, Swignition::RDFModel::Value->new($nsrdf.'List', 1));

	my $i = 1;

	# Parse <meta>
	foreach my $m ($this->{DOM}->getElementsByTagName('meta'))
	{
		# Value
		my $content = length($m->getAttribute('content')) ?
		                   $m->getAttribute('content') :
		                   Swignition::GenericParser::Utils::STRINGIFY($m);

		# @http-equiv
		my $name = $m->getAttribute('http-equiv');
		if (length $name)
		{
			my $huri = Swignition::GenericParser::HTTP::consume_header($this, $SubjectThisPage, $name, $content);
			$HTTPEq->addVal('http://buzzword.org.uk/rdf/list-items/_'.$i,
				Swignition::RDFModel::Value->new($huri, 1));
			$i++;
		}
		
		# @name
		else
		{
			$name = $m->getAttribute('name');
			next unless (length $name);

			$name =~ s/(^\s+|\s+$)//g;
			$name =~ s/\s+/ /g;
			my @name = split / /, $name;
			
			foreach my $n (@name)
			{
				my $nsname = reservedWordOrCurie($this, $n, $m);
				my $val    = Swignition::RDFModel::Value->new($content);
				$val->setDom($m);
				if ($m->getAttribute('scheme'))
				{
					my $nsscheme = reservedWordOrCurie($this, $m->getAttribute('scheme'), $m);
					$val->setVocab($nsscheme);
				}
				$SubjectThisPage->addVal($nsname, $val);
			}
		}
	}
	
	if ($i > 1)
	{
		$this->mergeSubject($HTTPEq);
		$SubjectThisPage->addVal('http://buzzword.org.uk/rdf/http-ext#http-equiv-headers',
			Swignition::RDFModel::Value->new($HTTPEq->uri, 1));
	}

	$this->mergeSubject($SubjectThisPage);
}


sub reservedWordOrCurie
{
	my $page  = shift;
	my $str   = shift;
	my $dom   = shift;
	my $xpath = $dom->getAttribute('_xpath') if ($dom);
	my $safe  = 0;
	
	if ($str =~ /^(application-name|description|generator|cache|keywords|robots)$/i)
	{
		return 'http://buzzword.org.uk/rdf/h5#'.lc($1);
	}
	
	# Cope with safe CURIEs.
	if ($str =~ /^\[(.*)\]$/)
	{
		$str  = $1;
		$safe = 1;
	}
	
	# If the string matches CURIE syntax, then resolve the CURIE.
	# This function allows a slightly looser CURIE syntax. Allows dots.
	if ($str =~ /^([a-z_][^\s\:\.]*)[\:\.](.*)$/i)
	{
		my $pfx = $1;
		my $sfx = $2;
		my $ns  = Swignition::Namespace::bestMatch($pfx, $xpath, @{$page->{Namespaces}});
		
		return $page->uri( $ns->{uri} . $sfx )
			if ($ns);
			
		return 'http://invalid.invalid/ns#'.$sfx
			if ($safe);
	}
	
	# If it wasn't a safe CURIE, then fall back to a URI.
	if (!$safe)
	{
		return $page->uri($str, {'require-absolute'=>1,'element'=>$dom});
	}
	
	return undef;
}


1;
